home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / tool_inc.zip / PULL.INC < prev    next >
Text File  |  1989-03-01  |  6KB  |  230 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * pull - utility library for simple "pull-down" windows
  15.  *        uses functions in popup.inc (3-1-89)
  16.  *
  17.  *)
  18.  
  19. const
  20.    max_pulldown = 10;
  21.  
  22.    quit_sel = #255;      {special select value to quit top menu}
  23.    divider_entry = -254; {special action value for divider lines}
  24.    unused_entry  = -255; {special action value for unused pulldown entries}
  25.  
  26. type
  27.    pulldown_entry = record
  28.       title:  string[40];
  29.       action: integer;
  30.    end;
  31.  
  32.    pulldown_rec = record
  33.       border:    border_styles;
  34.       border_fg: byte;
  35.       border_bg: byte;
  36.       text_fg:   byte;
  37.       text_bg:   byte;
  38.       select_fg: byte;
  39.       select_bg: byte;
  40.       ainit:     integer;
  41.       aexit:     integer;
  42.       line:      array[1..max_pulldown] of pulldown_entry;
  43.    end;
  44.  
  45.  
  46. function pulldown_action(pullno:   integer;   (* pulldown menu number *)
  47.                          entry:    integer;   (* entry in pulldown menu *)
  48.                          action:   integer;   (* action code *)
  49.                          var sel:  char)      (* select key *)
  50.                              : boolean;       (* true to force menu exit *)
  51.    {pulldown action routine; called when a pulldown entry is selected}
  52. forward;
  53.  
  54. procedure pulldown_init(pullno:    integer;
  55.                         action:    integer;
  56.                         var sel:   char);
  57.    {pulldown init routine; called when a pulldown menu is opened}
  58. forward;
  59.  
  60. procedure pulldown_exit(pullno:    integer;
  61.                         action:    integer;
  62.                         var sel:   char);
  63.    {pulldown exit routine; called when a pulldown menu is closed}
  64. forward;
  65.  
  66. function pulldown_key   (pullno:   integer;   (* pulldown menu number *)
  67.                          entry:    integer;   (* entry in pulldown menu *)
  68.                          var sel:  char)      (* select key *)
  69.                              : boolean;       (* true to force menu exit *)
  70.    {process unknown keys}
  71. forward;
  72.  
  73.  
  74. procedure pulldown(topx,topy:   integer;
  75.                    pullno:      integer;
  76.                    var pull:    pulldown_rec;
  77.                    var sel:     char);
  78.    {pulldown window processor; display the pulldown window and
  79.     select an entry from it}
  80.  
  81.    procedure display_entry(entry: integer);
  82.    begin
  83.       gotoxy(1,entry);
  84.       disp(' '+pull.line[entry].title);
  85.       clreol;
  86.       gotoxy(2,entry);
  87.    end;
  88.  
  89.    procedure display_pulldown;
  90.       {open a pulldown window at top-left x and y location.
  91.        use the pull record to describe the options}
  92.    var
  93.       i:            integer;
  94.       longest:      integer;
  95.       active:       integer;
  96.       botx,boty:    integer;
  97.  
  98.    begin
  99.  
  100.    (* determine longest selection title *)
  101.       active := 0;
  102.       longest := 0;
  103.       for i := 1 to max_pulldown do
  104.          with pull.line[i] do
  105.          begin
  106.             if length(title) > longest then
  107.                longest := length(title);
  108.             if action <> unused_entry then
  109.                inc(active);
  110.          end;
  111.  
  112.    (* determine bottom right location *)
  113.       botx := topx + longest + 4;
  114.       boty := topy + active + 1;
  115.       while botx > 79 do
  116.       begin
  117.          dec(topx);
  118.          dec(botx);
  119.       end;
  120.       while boty > 24 do
  121.       begin
  122.          dec(topy);
  123.          dec(boty);
  124.       end;
  125.  
  126.    (* draw the frame *)
  127.       window(1,1,80,25); 
  128.       setcolor(pull.border_fg, pull.border_bg);
  129.       display_border(topx,topy,botx,boty,pull.border);
  130.  
  131.    (* define the new window and print option descriptions *)
  132.       window(topx+1,topy+1,botx-2,boty-1);
  133.       setcolor(pull.text_fg,pull.text_bg);
  134.       for i := 1 to active do
  135.          display_entry(i);
  136.    end;
  137.  
  138.  
  139.    procedure pick_pulldown;
  140.       {select an entry from a pulldown window.
  141.        the pulldown must already be on the display}
  142.    var
  143.       found: integer;
  144.       i:     integer;
  145.       entry: integer;
  146.  
  147.       procedure moveby(by: integer);
  148.       begin
  149.          repeat
  150.             entry := entry + by;
  151.             if entry > max_pulldown then
  152.                entry := 1
  153.             else if entry < 1 then
  154.                entry := max_pulldown;
  155.         until pull.line[entry].action >= 0;
  156.       end;
  157.  
  158.  
  159.    begin
  160.       (* pick the initial selection *)
  161.       entry := 0;
  162.       moveby(1);
  163.  
  164.       (* determine what user wants *)
  165.       repeat
  166.          found := 0;
  167.          setcolor(pull.select_fg,pull.select_bg);
  168.          display_entry(entry);
  169.  
  170.          sel := upcase(getkey);
  171.  
  172.          setcolor(pull.text_fg,pull.text_bg);
  173.          display_entry(entry);
  174.  
  175.          case sel of
  176.             ESC,
  177.             LEFT,
  178.             RIGHT:     exit;
  179.  
  180.             UP:        moveby(-1);
  181.             DOWN:      moveby(1);
  182.  
  183.             NEWLINE:   found := entry;
  184.  
  185.             else
  186.                begin
  187.                   (* test for capitalized letters *)
  188.                   for i := max_pulldown downto 1 do
  189.                   with pull.line[i] do
  190.                      if pos(sel, title) > 0 then
  191.                      begin
  192.                         entry := i;
  193.                         found := -1;
  194.                      end;
  195.  
  196.                   if found = 0 then
  197.                   begin
  198.                      if pulldown_key(pullno,entry,sel) then
  199.                         exit;
  200.                   end;
  201.                end;
  202.          end;
  203.  
  204.          (* an entry was found; select it and perform the action *)
  205.          if found > 0 then
  206.          begin
  207.             entry := found;
  208.             setcolor(pull.select_fg,pull.select_bg);
  209.             display_entry(entry);
  210.  
  211.             if pulldown_action(pullno,entry,
  212.                                pull.line[entry].action,sel) then
  213.                exit;
  214.          end;
  215.  
  216.       until true=false;
  217.    end;
  218.  
  219.  
  220. begin {pulldown}
  221.  
  222.    pulldown_init(pullno,pull.ainit,sel);
  223.    display_pulldown;
  224.    pick_pulldown;
  225.    window(1,1,80,25);
  226.    pulldown_exit(pullno,pull.aexit,sel);
  227.  
  228. end;
  229.  
  230.